Shareware Grab Bag/Shareware Grab Bag.iso/090/byte1286.arc/PERRY.ARC/CELLULAR.PAS

Pascal/Delphi Source File | 1980-01-01 | 10.1 KB | 485 lines

program cellular;
{one dimensional cellular automata }
{ PROCEDURES
1  procedure DisplayStatusLine;
2  procedure DisplayGenerations;
3  procedure ReadRuleFromFile; (not used in this program)
4  procedure GetRandomRule;
5  procedure ChangeRule;     (from keyboard)
6  procedure InitializeAinitToBackground;
7  procedure InitializeAinitRandom;
8  procedure MoveAinitToAfield;
9  procedure InitializeAinitFromKeyboard;
10 procedure SetBackground;
11 procedure StartFinish;
12 procedure Field80X47;
13 procedure Field160X95;
14 procedure Field320X190;
15 procedure ReadRuleAndAinitFromFile;
  (not used in this program)
}

var
  FilVar:    text;
  Line:      string[20];
  C:         string[1];

  Ainit:     array[0..4000] of byte;
   {4001 cells wide. Allows for }
  Afield:    array[0..4000] of byte;
   { expansion of COMPUTE FIELD }
  Bfield:    array[0..4000] of byte;

  Rule:        array[0..12] of byte;
  I,J,M,N,H,P,V,X,Nix:  integer;
  Ch:               char;

  Delta:    integer;  { pixel spacing  1, or 2 }
  Dwidth:   Integer;  { width of display field }
  Cwidth:   Integer;  { width of compute field }

  Cstart:   integer;  { COMPUTE FIELD. start with a }
  Cfinish:  integer;  { width of 160 }

  Dstart:   integer;  { display field }
  Dfinish:  integer;

  Vstart:   integer;  { vertical display }
  Vfinish:  integer;

  Hstart:   integer;  { horizontal display }
  Hfinish:  integer;

const { typed constants }
      { these are essentially initialized variables }

  Widen:    Integer = 0;
  Bgnd:     Integer = 0;

  k:        integer = 4;   { number of states }
  RuleEnd:  integer = 9;   {  RuleEnd = 3 * (k - 1) }
  r:        integer = 1;   { Range; number of neighbors }



const
  Center = 2000;    {center of fields}
{ **********  start of procedures ******************* }

{----------------- 1 ----------------}

procedure DisplayMessage;
begin
  GoToXY(1,25);
  Write('CELLULAR: by Kenneth E. Perry.
         Press Ins');
end;

procedure DisplayStatusLine;
begin
  GoToXY(1,25);
  Write('                                            ');
  GoToXY(1,25);
  Write(Rule[0]);
  for I := 1 to 3 do
  begin
    write(' ');
    for J := 1 to 3 do
    begin
      Write(Rule[3*(I-1)+J]);
    end;
  end;
  Write('    ');  {4 spaces}
  Write(Bgnd);
  Write('    ');
  Write(Cwidth);
end;            {DisplayStatusLine}

{---------------- 2 -----------------}

procedure DisplayGenerations;
{ compute and display 190 generations
( or rows of cells ) }
begin
    for V := Vstart to Vfinish do
    { number of generations to display }
    begin
             { show display field }
      if Delta = 1 then
      begin
        for H := Hstart to Hfinish do
        begin
          I := H + Dstart; { display one generation }
          plot(H,V,Afield[I]);
        end;
      end;

      if Delta = 2 then
      begin
        for H := Hstart to Hfinish do
        begin
          I := H + Dstart;
          plot(H+H,V+V,Afield[I]);
        end;
      end;

            { check for overflow of COMPUTE FIELD }

  if Widen = 1 then
  begin
  I := Cstart;
  J := Cfinish;
  if (Afield[I] <> Afield[I + 1]) or (Afield[J - 1]
  <> Afield[J]) then
  begin
    Cstart := Cstart - 1;   { this is to avoid end effects }
     Cfinish := Cfinish + 1;
     Cwidth := Cfinish - Cstart;
   end;
  end;

             {compute new row of cells and place in Bfield }

      for I := Cstart to Cfinish do
      begin
        N := Afield[I-1] + Afield[I] + Afield[I+1];
        Bfield[I] := Rule[N];
      end;

               {return Bfield to Afield}
      for I := Cstart to Cfinish do
      begin
        Afield[I] := Bfield[I];
      end;

    end; {for}
end;  { DisplayGenerations }

{-------------------- 3 -------------------}

  procedure ReadRuleFromFile;
  begin  {read rule from file 'DEMO-C.DOC' into 'Line'}
    Readln(FilVar,Line);
    GotoXY(1,25);
    Writeln(Line); { display rule on bottom
                     line of screen }
 J := 0;
 for I := 1 to 13 do
 begin
   C := Copy(Line,I,1); { copy rule, one digit at a time }
   if (C <> ' ') then   { skipping spaces }
   begin
     Val(C,M,Nix);
        Rule[J] := M; { copy rule from 'Line' into 'Rule' }
        J := J + 1;
      end;
    end;
  end;    { ReadRuleFromFile }

{-------------------- 4 --------------------}

  procedure GetRandomRule;
  begin
    Rule[0] := 0;
    Rule[1] := Random(k);
    Rule[2] := Random(k);
    Rule[3] := Random(k);
    Rule[4] := Random(k);
    Rule[5] := Random(k);
    Rule[6] := Random(k);
    Rule[7] := Random(k);
    Rule[8] := Random(k);
    Rule[9] := Random(k);
  end;  { GetRandomRule }

{-------------------- 5 ---------------------}

  procedure ChangeRule;
  begin
    Rule[0] := 0;
    GoToXY(3,25);
    for i := 1 to 11 do
    begin
      Write(' ');
    end;
    GotoXY(3,25);
    for I := 1 to RuleEnd do
    begin
     Read(Kbd,C);
     Val(C,M,X);
     Rule[I] := M;
     Write(Rule[I]);
    end;
    DisplayStatusLine;
  end;  { ChangeRule }

{-------------------- 6 ---------------------}

procedure InitializeAinitToBackground;
begin
  for I := 0 to 4000 do
  begin
    Ainit[I] := Bgnd;
  end;
end;

{-------------------- 7 ---------------------}

procedure InitializeAinitRandom;
begin
  { random initialize of COMPUTE FIELD in Ainit}
    for I := Cstart to Cfinish do
    begin
      Ainit[I] := Random(k);
    end;
end;      { InitializeAinitRandom }

{-------------------- 8 ---------------------}

procedure MoveAinitToAfield;
begin
    for I := 0 to 4000 do
    begin
      Afield[I] := Ainit[I];
    end;
end;

{-------------------- 9 ----------------------}

procedure InitializeAinitFromKeyboard;
begin
  InitializeAinitToBackground;
  GraphColorMode;
  Delay(400);
  DisplayStatusLine;
  Plot(160,2,1); {display pixel cursor on "line 2" }
  For I := 0 to (319 div Delta) do
  begin
    Plot(I*Delta,0,bgnd); { show background on "line 0" }
  end;
  M := Center;
  N := 160 div Delta;
  C := ' ';

  repeat
    if keypressed then
    begin
      Read(Kbd,C);
      if (C <> #27) and (C <> #42) then
      begin
 Plot(N * Delta,2,0); { erase pixel cursor }
 val(C,P,Nix);        { C is String[1], P is integer }
 Ainit[M] := P;
 Plot(N * Delta,0,P);
 M := M + 1;
 N := N + 1;
 Plot(N * Delta,2,1); { write new pixel cursor }
end;

  if (C = #27) and keypressed then
  begin
  Plot(N * Delta,2,0);
  Read(Kbd,C);
  if (C = #75) then     { left arrow }
  begin
          M := M - 1;
          N := N - 1;
        end;
        if (C = #77) then     { right arrow }
        begin
          M := M + 1;
          N := N + 1;
        end;
        Plot(N * Delta,2,1);
      end;
    end;
  until (C = #42);     { * on keypad }

  Widen := 1;
  MoveAinitToAfield;
  DisplayGenerations;

end;      { InitializeAinitFromKeyboard }

{------------------- 10 -----------------}

procedure SetBackground;
begin
  read(Kbd,C);
  Val(C,M,X);
  Bgnd := M;
  DisplayStatusLine;
end;

{------------------- 11 -----------------}

procedure StartFinish;
begin
  Cstart := Center - (Cwidth div 2);
  Cfinish := Center + (Cwidth div 2) - 1;
  Dstart := Center - (Dwidth div 2);
  Dfinish := Center + (Dwidth div 2) - 1;
end;

{------------------ 12 ------------------}

procedure Field80X47;
begin
  GraphColorMode;
  Dwidth := 80;
  Cwidth := 80;

  StartFinish;

  Vstart := 0;
  Vfinish := 48;
  Hstart := 0;
  Hfinish := 79;
  Delta := 2;
  Delay(400);
  DisplayStatusLine;
end;

{-------------------13 ------------------}

procedure Field160X95;
begin
  GraphColorMode;
  Dwidth := 160;
  Cwidth := 160;

  StartFinish;

  Vstart := 0;
  Vfinish := 94;
  Hstart := 0;
  Hfinish := 159;
  Delta := 2;
  Delay(400);
  DisplayStatusLine;
end;

{-------------------14 -----------------}

procedure Field320X190;
begin
  GraphColorMode;
  Dwidth := 320;
  Cwidth := 320;

  StartFinish;

  Vstart := 0;
  Vfinish := 189;
  Hstart := 0;
  Hfinish := 319;
  Delta := 1;
  Delay(400);
  DisplayStatusLine;
end;




{ *************   end  of procedures ***************** }



{ ************** MAIN PROGRAM ************************ }


begin

Ch := ' ';
GraphColorMode;
Palette(0);
Randomize;
Field160X95;
DisplayMessage;

repeat
  if KeyPressed then
  begin               {keypad symbols}
    Read(Kbd,Ch);
    if (Ch = #45) then             { - }
    begin
      InitializeAinitFromKeyboard
    end;


    if (Ch = #43) then            { + }
    begin                 { Continue Structure }
      DisplayStatusLine;
      DisplayGenerations;
    end;

        {escape sequences}

 if (Ch = #27) and KeyPressed then {one more char?}
    begin
      Read(Kbd,Ch);

      if (Ch = #82) then        { ins }
      begin       { Random Rule Random Inititialize }
        Widen := 0;
        GetRandomRule;
        DisplayStatusLine;
        InitializeAinitToBackground;
        InitializeAinitRandom;
        MoveAinitToAfield;
        DisplayGenerations;
      end;

      if (Ch = #83) then      { del }
      begin      { Same Rule Random Inititialize }
        Widen := 0;
        DisplayStatusLine;
        InitializeAinitToBackground;
        InitializeAinitRandom;
        MoveAinitToAfield;
        DisplayGenerations;
      end;


        {function keys}

      if (Ch = #59) then                  { F1 }
      begin
      ChangeRule;
      end;

      if (Ch = #60) then                  { F2 }
      begin
      SetBackground;
      end;

      if (Ch = #61) then                  { F3 }
      begin
      end;


      if (Ch = #66) then                  { F8 }
      begin
      Field80X47;
      end;

      if (Ch = #67) then                  { F9 }
      begin
      field160X95;
      end;

      if (Ch = #68) then                  { F10 }
      begin
      Field320X190;
      end;

    end;  { if (Ch = #27 }
  end;  { if keypressed }
until Ch = #13;  { Return }  { end repeat }


end.